SORTING BY SURNAMES

Home

View 3D

Math for LB

Using the Modem

Functions

Subroutines

Hall of Fame

API Corner

Tip Corner - RUN

Clipart Viewer

User Design Graphics

Sort by Surnames

Many Textboxes

Newsletter help

Index

In order to sort names by Surname etc, the practice adopted by many Databases is to expect you to create a separate field containing the surname, then the Christian name or Forename and arrange the sorting by this field.

Many years ago, long before the days of LB or probably Windows, I developed a routine in other forms of Basic for sorting names by Surname/Initials/Title, and have periodically upgraded this. A working example is shown below. I have now tried to follow the generally accepted procedures regarding indenting etc, although it has of course resulted in a considerable increase in lines. I have also passed it through Alyce's clever Workshop for further improvement.

Normally data would be collected from a Sequential or Random Access file, but for simplicity this is provided by a set of sample DATA. You will notice the sorting will accept only certain Titles, and warns of an incompatible ' Dr ' title among the samples. The list of acceptable Titles could easily be changed, although further alterations are needed if you wish to increase or reduce the number of Titles. Gordon Sweet

    
NoMainWin
    Dim dat$(1010, 7)
    COUNT = 6          ' TOTAL SAMPLE ENTRIES
    Restore [samples]  ' DATA WOULD NORMALLY BE READ FROM A FILE
    For dat = 1 to COUNT
        For row = 1 to 4
            Read i$ : dat$(dat,row) = i$
        Next row
    Next dat


[1950] Rem Alphasort of Surnames
    NoMainWin
    ux = 1 : uy = 1
    If DisplayWidth > 1000 Then ux = 120 : uy = 90
    UpperLeftX = ux : UpperLeftY = uy
    WindowWidth = 800 : WindowHeight = 580
    Open "Alpha Sort" For Graphics_nsb As #9
    #9 "cls; trapclose [zfin]; place 100 30"
    #9 "\Unsorted Data"
    GoSub [show]
    #9 "\PLEASE WAIT"  ' FOR SLOW CPUs OR NUMEROUS ENTRIES
    #9 "color red"
    For R = 1 TO COUNT
        L = 0 : newline$ = dat$(R, 1) : AL = Len(newline$)
        If Left$(newline$, 3) = "Mr " Then L = 2
        If Left$(newline$, 3) = "Ms " Then L = 2
        If Left$(newline$, 4) = "Mrs " Then L = 3
        If Left$(newline$, 5) = "Miss " Then L = 4
        If Left$(newline$, 9) = "Mr & Mrs " Then
            L = 8
            newline$ = "@@@@@@@@" + Right$(newline$, AL - 7)
        End If
        If L >0 Then GoTo [titleOK]

        error$ = "AMEND INCOMPATIBLE ENTRY "; R; " "; dat$(R, 1)
        Notice error$
        newline$ = "*." + Left$(newline$, AL - 2): L = 1

[titleOK]
        title$ = Left$(newline$, L)
        newline$ = Right$(newline$, AL - L)
        L = Len(newline$)
        P = 0
        FIN = 0
        While FIN = 0: P = P + 1
            gap$ = Right$(newline$, P)
            If Left$(gap$, 1) <> " " Then FIN = 1
        Wend
        P = P - 1
        newline$ = Left$(newline$, L - P)
        L = Len(newline$)
        P = 0
        FIN = 0
        While FIN = 0: P = P + 1
            gap$ = Right$(newline$, P)
            If Left$(gap$, 1) = "." OR Left$(gap$, 1) = " " Then FIN = 1
        Wend
        P = P - 1
        Z = L - P - 1
        new$ = Right$(newline$, P)
        fname$ = Left$(newline$, Z)
        new$ = new$ + fname$ + " " + title$
        L = Len(title$)
        dat$(R, 1) = new$
    Next R
    Sort dat$(), 1, COUNT, 1
    For C = 1 TO COUNT
        newline$ = dat$(C, 1) + "   ": AL = Len(newline$)
        L = AL
        For N = 1 TO 3
            P = 0
            FIN = 0
            While FIN = 0
                P = P + 1
                gap$ = Left$(newline$, P)
            If Right$(gap$, 1) = " " OR P > L Then FIN = 1
            Wend
            If N = 1 Then sname$ = Left$(gap$, P - 1)
            If N = 2 Then fname$ = Left$(gap$, P - 1) + "."
            If N = 3 Then title$ = Left$(gap$, P)
            Z = Len(fname$) - 1
            If title$ = " " Then title$ = Left$(fname$, Z): fname$ = " "
            newline$ = Right$(newline$, L - P)
            L = Len(newline$)
        Next N
        new$ = title$ + fname$ + sname$: L = Len(new$)
        If Left$(new$, 8) = "@@@@@@@@" Then new$ = "Mr & Mrs" + Right$(new$, L - 8)
        dat$(C, 1) = new$
    Next C
    #9 "\\Sorted Data."
    GoSub [show]
    #9 "flush"
    Notice "ALL DONE" : GoTo [quit]

[show]
    For dat = 1 to COUNT
        show$ = "\"
        For row = 1 to 4
            show$ = show$ + dat$(dat,row)+", "
        Next row
        #9 show$
    Next dat
    Return

[zfin]
    Notice "Aborting sorting has destroyed Data"

[quit]
    Close #9 : End

[samples]
    Data "Mrs Zara Ziegler","33 Silver Road","Westminster","London W1"
    Data "Mr Tom Brown","Schooldays, West Avenue","New York","USA"
    Data "Miss Jean Harlow","1122 The Boulevarde","Hollywood","California"
    Data "Ms J.Smith","4 Silver Lane","Hastings","East Sussex"
    Data "Mr & Mrs Rosy Apple","1 Ginger Street","Bristol","Wiltshire"
    Data "Dr. John Brown","5 Harley Street","Pimloco","London W1"



Home

View 3D

Math for LB

Using the Modem

Functions

Subroutines

Hall of Fame

API Corner

Tip Corner - RUN

Clipart Viewer

User Design Graphics

Sort by Surnames

Many Textboxes

Newsletter help

Index